home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / wgsave11.zip / TESTSCRN.PAS < prev   
Pascal/Delphi Source File  |  1993-07-13  |  4KB  |  161 lines

  1. { TESTSCRN.PAS
  2.   Program to demonstrate the ScrnSav Unit
  3.   Written by Rutger van de GeVEL, 9 july 1993.
  4.  
  5.   W. Gross : Take care of checking boolean var ScreenSaverMode in
  6.              your Idle routine (see below).
  7.              Some 8-bit char's might get clobbered if this program
  8.              is e-mailed.
  9. }
  10.  
  11. Program TestScrn;
  12.  
  13. Uses
  14.    Objects, Drivers, App, Views, Menus, Crt, ScrnSave, Dialogs, Gadgets;
  15.  
  16. Const
  17.    cmAbout  = 1100;
  18.  
  19. Type
  20.    PTestApp = ^TTestApp;
  21.    TTestApp = Object (TScreenSaverApp)
  22.               Heap: PHeapView; Clock : PClockView;
  23.               Constructor Init;
  24.               Procedure HandleEvent (Var Event: TEvent); Virtual;
  25.               Procedure Idle; virtual;
  26.               Procedure InitMenuBar; Virtual;
  27.               Procedure ScreenSaver; Virtual;
  28.               Procedure DoAboutDialog;
  29.               End;
  30.  
  31.  
  32. Var
  33.    TestApp  : TTestApp;
  34.  
  35.  
  36. Procedure PutXY (X, Y: Integer; S: String);
  37.  
  38.    Begin (* PutsXY *)
  39.    GotoXY (X, Y);
  40.    Write (S);
  41.    End;  (* PutsXY *)
  42.  
  43.  
  44. Function AboutDialog: PDialog;
  45. Var
  46.    Dialog : PDialog;
  47.    R      : TRect;
  48.  
  49.    Begin (* AboutDialog *)
  50.    R.Assign (0, 0, 46, 15);
  51.    Dialog:= New (PDialog, Init (R, 'About'));
  52.    With Dialog^ Do
  53.         Begin
  54.         Options:= Options Or ofCentered;
  55.         HelpCtx:= $A000;
  56.         R.Grow (-1, -1);
  57.         Dec (R.B.Y, 3);
  58.         Insert (New (PStaticText, Init (R,
  59.                 #13 + ^C'A ScreenSaver Demo'#13 +
  60.                 #13 + ^C'ScrnSav source-code by Wolfgang Gross'#13 +
  61.                       ^C'Email: Gross@aecds.exchi.uni-heidelberg.de'#13 +
  62.                 #13 + ^C'Adapted by Rutger van de GeVEL'#13 +
  63.                       ^C'E-mail: Rutger@kub.nl'#13 +
  64.                 #13 + ^C'ScreenSaver activates in 1 minute.')));
  65.         R.Assign (18, 12, 28, 14);
  66.         Insert (New (PButton, Init (R, '~O~k', cmOk, bfDefault)));
  67.         End;
  68.    AboutDialog:= Dialog;
  69.    End;  (* AboutDialog *)
  70.  
  71.  
  72. Constructor TTestApp.Init;
  73.    VAR R : TRect;
  74.    Begin (* TTestApp.Init *)
  75.    Inherited Init;
  76.    SleepTime:= 6000;                 { Start screen saver after 1 minute }
  77.  
  78.     GetExtent(R);
  79.     R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  80.     Clock := New(PClockView, Init(R));
  81.     Insert(Clock);
  82.  
  83.     GetExtent(R);
  84.     Dec(R.B.X);
  85.     R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  86.     Heap := New(PHeapView, Init(R));
  87.     Insert(Heap);
  88.  
  89.    DoAboutDialog;
  90.    End;  (* TTestApp.Init *)
  91.  
  92.  
  93. Procedure TTestApp.HandleEvent (Var Event: TEvent);
  94.  
  95.    Begin (* TTestApp.HandleEvent *)
  96.    Inherited HandleEvent (Event);
  97.    Case (Event.What) Of
  98.         evCommand: Case (Event.Command) Of
  99.                         cmAbout : DoAboutDialog;
  100.                      Else
  101.                         Exit;
  102.                      End;
  103.      Else
  104.         Exit;
  105.      End;
  106.    ClearEvent (Event);
  107.    End;  (* TTestApp.HandleEvent *)
  108.  
  109. PROCEDURE TTestApp.Idle;
  110.   BEGIN
  111.     inherited Idle;                       {+++ do this in ScrnSaverMode ???}
  112.     IF NOT ScreenSaverMode THEN
  113.       BEGIN
  114.         Heap^.Update; Clock^.Update;
  115.       END;
  116.   END;{PROC TTestApp.Idle}
  117.  
  118. Procedure TTestApp.InitMenuBar;
  119. Var
  120.    R: TRect;
  121.  
  122.    Begin (* TTestApp.InitMenuBar *)
  123.    GetExtent (R);
  124.    R.B.Y:= R.A.Y + 1;
  125.    MenuBar:= New (PMenuBar, Init (R, NewMenu (
  126.                NewItem ('~A~bout', '', kbAltSpace, cmAbout, hcNoContext,
  127.                Nil))));
  128.    End;  (* TTestApp.InitMenuBar *)
  129.  
  130.  
  131. Procedure TTestApp.ScreenSaver;
  132. Var
  133.    X, Y: Integer;
  134.  
  135.    Begin (* TTestApp.ScreenSaver *)
  136.    X:= Random (38) + 1;
  137.    Y:= Random (17) + 1;
  138.    PutXY (X, Y  , '┌───────────────────────────────────┐');
  139.    PutXY (X, Y+1, '│    Demo in ScreenSaver mode to    │');
  140.    PutXY (X, Y+2, '│        preserve the monitor       │');
  141.    PutXY (X, Y+3, '│    Move mouse or press any key    │');
  142.    PutXY (X, Y+4, '│           to continue ...         │');
  143.    PutXY (X, Y+5, '└───────────────────────────────────┘');
  144.    LastTime:= Time;
  145.    End;  (* TTestApp.ScreenSaver *)
  146.  
  147.  
  148. Procedure TTestApp.DoAboutDialog;
  149.  
  150.    Begin (* TTestApp.DoAboutDialog *)
  151.    ExecuteDialog (AboutDialog, Nil);
  152.    End;  (* TTestApp.DoAboutDialog *)
  153.  
  154.  
  155. Begin (* Main Program *)
  156. TestApp.Init;
  157. TestApp.Run;
  158. TestApp.Done;
  159. End.  (* Main Program *)
  160.  
  161.